home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / yosig2 / yosig2.bas next >
BASIC Source File  |  1993-07-08  |  12KB  |  390 lines
  1. 10 COLOR ,,,4
  2. 20 DIM X(101,181),Y(101,181),Z(101,181)
  3. 30 CONSOLE 0,25,0
  4. 40 FOR L = 1 TO 10
  5. 50  KEY L,""                      'key clear
  6. 60 NEXT
  7. 70 '
  8. 80 COLOR 7,0,7
  9. 90 P = 1           'デフォルト
  10. 100 N = 4           'デフォルト
  11. 110 π = ATN(1)*4*2 'ラジアン設定
  12. 120 CLS
  13. 130 LOCATE 9,24
  14. 140 INPUT "Japanese or English (J/E)? >",IN$
  15. 150 '
  16. 160 IF IN$ = "J" OR IN$ = "j" OR IN$ = "E" OR IN$ = "e" THEN 170 ELSE 120
  17. 170 IF IN$ = "J" OR IN$ = "j" THEN J = 1:RESTORE *JAPANESE ELSE GOTO 180
  18. 180 '
  19. 190 CLS
  20. 200 LOCATE 0,24
  21. 210 '
  22. 220   SYMBOL (13*8*(L-1),25*16+54),"PF"+STR$(L)+"-",1,1,4
  23. 230  READ A$
  24. 231   COLOR 7
  25. 240   IF A$ = "Eom" THEN 270
  26. 250   IF LEFT$(A$,1) = "*" THEN COLOR 3
  27. 251   PRINT A$
  28. 260  GOTO 230
  29. 270 '
  30. 280 READ K_KOSU
  31. 290  FOR L = 1 TO K_KOSU
  32. 300   READ K$(L)                             'PF key 初期設定
  33. 310   KEY L,K$(L)
  34. 320  NEXT
  35. 330 GOSUB *PF_KEYS
  36. 340 '
  37. 350  FOR L=1 TO 2
  38. 360   READ SUBM$(L)
  39. 370  NEXT
  40. 380  '
  41. 390 READ I
  42. 410  FOR L = 1 TO I
  43. 420   READ QUES$(L)                            '質問設定
  44. 430  NEXT
  45. 431  '
  46. 432  D$=INPUT$(1)                             'キー待ち
  47. 440  '
  48. 450 CLS 4
  49. 460 '
  50. 470 *MAIN
  51. 480  '
  52. 490  CLS 4
  53. 500  LOCATE 3,23
  54. 510  PRINT QUES$(1);
  55. 520  INPUT "",CM$
  56. 530  IF CM$ = "" THEN L = L1:GOTO 600
  57. 540  '
  58. 550  FOR L = 1 TO K_KOSU
  59. 560   IF CM$ = K$(L) THEN 590
  60. 570  NEXT
  61. 580  GOTO *MAIN
  62. 590  '
  63. 600  L1 = L:ON L GOSUB *DRAW,*SPIN,*CHANGE,*SAVE,*RESET,*END
  64. 610  GOTO *MAIN
  65. 620 '
  66. 630 *DRAW
  67. 640  ERASE X,Y,Z
  68. 641  XYZ$=""
  69. 650  CLS
  70. 660  GOSUB *PF_KEYS
  71. 670 '
  72. 680  FOR C = 1 TO 7
  73. 690   SYMBOL (500,40+C*36),STR$(C)+" ■",1,1,C  'カラーバー作製
  74. 700  NEXT
  75. 710  PRINT 
  76. 720 '
  77. 730  LOCATE 3,22
  78. 740  PRINT QUES$(2); : INPUT "",P$
  79. 750  IF NOT P$ = "" THEN P = VAL(P$)
  80. 760  IF P<0 OR P>7 THEN BEEP : GOTO 720
  81. 770 '
  82. 780  LOCATE 6,23
  83. 790  PRINT QUES$(3); : INPUT "",N$
  84. 800  IF NOT N$ = "" THEN N = VAL(N$)
  85. 810  IF N<1 THEN BEEP : GOTO 780
  86. 820  IF N>50 THEN BEEP : GOTO 780
  87. 830  '
  88. 840  DIM X(N+1,181),Y(N+1,181),Z(N+1,181)
  89. 850 '
  90. 860  CLS 4
  91. 870  SYMBOL (400,360),SUBM$(1)+STR$(N),1,1,7              '何角形か表示
  92. 880 ' 
  93. 890  FOR L = 1 TO N
  94. 900   X(L,1) = 200+200*COS(π/N*L) : X(L+1,1) = 200+200*COS(π/N*(L+1))
  95. 910   Y(L,1) = 200+200*SIN(π/N*L) : Y(L+1,1) = 200+200*SIN(π/N*(L+1))
  96. 920   Z(L,1) = 200 : Z(L+1,1) = 200
  97. 930  NEXT
  98. 940 '
  99. 950  FOR I = 1 TO N
  100. 960   FOR L = 1 TO N
  101. 970    LINE (X(I,1),Y(I,1))-(X(L,1),Y(L,1)),PSET,P  '対角線を細く
  102. 980    '
  103. 990    'DEF PEN 0,2 
  104. 1000    LINE (X(L,1),Y(L,1))-(X(L+1,1),Y(L+1,1)),PSET,7'外枠を太く
  105. 1010    'DEF PEN 0,1 
  106. 1020    '
  107. 1030    IF INKEY$ = CHR$(27) THEN 1070                  'ESCキーを押した時
  108. 1040   NEXT
  109. 1050  NEXT
  110. 1060 '
  111. 1070  BEEP
  112. 1080 '
  113. 1090 RETURN
  114. 1100 '
  115. 1110 *SPIN
  116. 1120  CLS
  117. 1130  GOSUB *PF_KEYS
  118. 1140  '
  119. 1150  LOCATE 3,22 : PRINT QUES$(4);
  120. 1160  INPUT "",ANG$
  121. 1170  IF ANG$ = "" THEN ANG = VAL(ANG$)
  122. 1180  ANG = VAL(ANG$)
  123. 1190  IF 1>ANG OR ANG>360 THEN BEEP : CLS 4 : GOTO 1150
  124. 1200 '
  125. 1210  LOCATE 3,23 : PRINT QUES$(5);
  126. 1220  INPUT "",FRAME$
  127. 1230  IF FRAME$ = "" THEN FRAME = VAL(FRAME$)
  128. 1240  FRAME = VAL(FRAME$)
  129. 1250  IF 1>FRAME OR FRAME>360 THEN BEEP : CLS 4 : GOTO 1210
  130. 1260 '
  131. 1270  FOR J=1 TO FRAME
  132. 1280   FOR L = 1 TO N+1
  133. 1290    θ = ANG/FRAME
  134. 1300    J1 = J+1
  135. 1310    'Z(L,J) = 200
  136. 1320    GOSUB *Y_CNV
  137. 1330   NEXT
  138. 1340  NEXT
  139. 1350 '
  140. 1360  FOR J=1 TO FRAME
  141. 1370   FOR I = 1 TO N
  142. 1380    FOR L = 1 TO N
  143. 1390     LINE (X(I,J),Y(I,J))-(X(L,J),Y(L,J)),PSET,P        '対角線を細く
  144. 1400     '
  145. 1410     'DEF PEN 0,2 
  146. 1420      LINE (X(L,J),Y(L,J))-(X(L+1,J),Y(L+1,J)),PSET,7   '枠組みを太く
  147. 1430     'DEF PEN 0,1 
  148. 1440     '
  149. 1450     IF INKEY$ = CHR$(27) THEN 1500                'ESCキーを押した時
  150. 1460    NEXT
  151. 1470   NEXT
  152. 1480  NEXT
  153. 1490 '
  154. 1500  BEEP
  155. 1510 '
  156. 1520 RETURN
  157. 1530 '
  158. 1540 *CHANGE
  159. 1550  CLS
  160. 1560  GOSUB *PF_KEYS
  161. 1570  '
  162. 1580  LOCATE 3,22 : PRINT QUES$(6);
  163. 1590  INPUT "",F$
  164. 1600   IF F$="" THEN F$=F1$
  165. 1610   IF F$ = "x" OR F$ = "y" OR F$ = "z" THEN 1660
  166. 1620   IF F$ = "X" OR F$ = "Y" OR F$ = "Z" THEN 1660
  167. 1630  GOTO *CHANGE
  168. 1640  '
  169. 1650 '
  170. 1660  IF F$ = "x" OR F$ = "y" OR F$ = "z" THEN F$ = CHR$(ASC(F$)-32)
  171. 1670  FR = ASC(F$)-87 : F1$=F$                  '軸のデーターを数値に変換
  172. 1680 '
  173. 1690  LOCATE 3,23 : PRINT QUES$(7);
  174. 1700  INPUT "",ANG1$
  175. 1710  IF ANG1$="" THEN ANG1=VAL(ANG1$)
  176. 1720  ANG1 = VAL(ANG1$)
  177. 1730  IF 1>ANG1 OR ANG1>360 THEN BEEP : CLS 4 : GOTO 1690
  178. 1740 '
  179. 1741  ANG1=ANG1-((NOT ANG1>360)+1)*360 : XYZ(FR)=XYZ(FR)+ANG1
  180. 1742 '
  181. 1750  FOR J = 1 TO FRAME
  182. 1760   FOR L = 1 TO N+1
  183. 1770    θ = ANG1
  184. 1790    J1 = J
  185. 1800    ON FR GOSUB *X_CNV,*Y_CNV,*Z_CNV
  186. 1810   NEXT
  187. 1820  NEXT
  188. 1830 '
  189. 1832  XYZ$=""
  190. 1833  FOR L=1 TO 3 
  191. 1834   XYZ$=XYZ$+","+STR$(XYZ(L)-((NOT XYZ(L)>360)+1)*360)
  192. 1835  NEXT
  193. 1836  SYMBOL (400,360),SUBM$(2),1,1,7                     '現在の角度
  194. 1837  SYMBOL (400,376),XYZ$,1,1,7
  195. 1838 '
  196. 1840  FOR J = 1 TO FRAME
  197. 1850   FOR I = 1 TO N
  198. 1860    FOR L = 1 TO N
  199. 1870     LINE (X(I,J),Y(I,J))-(X(L,J),Y(L,J)),PSET,P        '対角線を細く
  200. 1880 '
  201. 1890     'def pen 0,2
  202. 1900     LINE (X(L,J),Y(L,J))-(X(L+1,J),Y(L+1,J)),PSET,7   '枠組みを太く
  203. 1910     'def pen 0,1
  204. 1920 '
  205. 1930     NEXT
  206. 1931    NEXT
  207. 1940   NEXT
  208. 1950 '
  209. 1960 RETURN
  210. 1970 '
  211. 1980 *SAVE
  212. 1981 CLS 4
  213. 1990  LOCATE 3,23 : PRINT QUES$(8);
  214. 2000  INPUT "",S$
  215. 2010  IF S$ = "" THEN S$ = S1$
  216. 2020  IF S$ = "" THEN BEEP : GOTO 1990
  217. 2030  S1$ = S$
  218. 2040  SAVE@ S$+".tif",(0,0)-(400,400)                      'セーブする
  219. 2050 '
  220. 2060 RETURN
  221. 2070 '
  222. 2080 *RESET
  223. 2090  CLS 4
  224. 2091  LOCATE 3,22 : PRINT QUES$(9);
  225. 2093  INPUT "",R$
  226. 2094  IF R$ = "N" OR R$ = "n" THEN *MAIN
  227. 2095  IF R$ = "Y" OR R$ = "y" THEN BEEP ELSE BEEP : GOTO *RESET
  228. 2096 RUN                                                    'リセットする
  229. 2100 '
  230. 2110 *END
  231. 2120  CLS 4
  232. 2121  LOCATE 3,22 : PRINT QUES$(10);
  233. 2122  INPUT "",E$
  234. 2123  IF E$ = "N" OR E$ = "n" THEN *MAIN
  235. 2124  IF E$ = "Y" OR E$ = "y" THEN BEEP ELSE  BEEP : GOTO *END
  236. 2125 END
  237. 2130 '
  238. 2140 *X_CNV
  239. 2150  GOSUB *CNV1
  240. 2160   GOSUB *MANUS
  241. 2170    θ = π*(θ/360*J)
  242. 2180    X1 = X
  243. 2190    Y1 = Z*SIN(θ)+Y*COS(θ)
  244. 2200    Z1 = Z*COS(θ)-Y*SIN(θ)
  245. 2210   GOSUB *PLUS
  246. 2220  GOSUB *CNV2
  247. 2230 RETURN
  248. 2240 '
  249. 2250 *Y_CNV
  250. 2260  GOSUB *CNV1
  251. 2270   GOSUB *MANUS
  252. 2280    θ = π*(θ/360*J)
  253. 2290    X1 = X*COS(θ)-Z*SIN(θ)
  254. 2300    Y1 = Y
  255. 2310    Z1 = X*SIN(θ)+Z*COS(θ)
  256. 2320   GOSUB *PLUS
  257. 2330  GOSUB *CNV2
  258. 2340 RETURN
  259. 2350  '
  260. 2360 '
  261. 2370 *Z_CNV
  262. 2380  GOSUB *CNV1
  263. 2390   GOSUB *MANUS
  264. 2400    θ = π*(θ/360*J)
  265. 2410    X1 = Y*SIN(θ)+X*COS(θ)
  266. 2420    Y1 = Y*COS(θ)-X*SIN(θ)
  267. 2430    Z1 = Z
  268. 2440   GOSUB *PLUS
  269. 2450  GOSUB *CNV2
  270. 2460 RETURN
  271. 2470 '
  272. 2480 *PLUS
  273. 2490  X1=X1+200
  274. 2500  Y1=Y1+200
  275. 2510  Z1=Z1+200
  276. 2520 RETURN
  277. 2530  '
  278. 2540 *MANUS
  279. 2550  X=X-200
  280. 2560  Y=Y-200
  281. 2570  Z=Z-200
  282. 2580 RETURN
  283. 2590 '
  284. 2600 *CNV1
  285. 2610  X=X(L,J)
  286. 2620  Y=Y(L,J)
  287. 2630  Z=Z(L,J)
  288. 2640 RETURN
  289. 2650 '
  290. 2660 *CNV2
  291. 2670  X(L,J1)=X1
  292. 2680  Y(L,J1)=Y1
  293. 2690  Z(L,J1)=Z1
  294. 2700 RETURN
  295. 2710 '
  296. 2720 *PF_KEYS
  297. 2730  FOR L = 1 TO K_KOSU
  298. 2740   'key設定
  299. 2750   SYMBOL (13*8*(L-1),25*16+54),"PF",1,1,4
  300. 2760   SYMBOL (13*8*(L-1)+1*8,25*16+54),STR$(L)+"-",1,1,4
  301. 2770   SYMBOL (13*8*(L-1)+5*8,25*16+54),K$(L),1,1,6
  302. 2780  NEXT
  303. 2790 RETURN
  304. 2800 '
  305. 2810 '▼▼▼▼▼▼▼▼▼▼▼DATA▼▼▼▼▼▼▼▼▼▼▼▼▼▼
  306. 2820 *ENGLISH'
  307. 2830  DATA "This program draws a figure which has as many apex as you like,"
  308. 2840  DATA "and draws diagonal lines in the color you like."
  309. 2850  DATA " (The number of '0' is black.)"
  310. 2860  DATA "If you hit ESC key, it stops making apex and diagonal lines." 
  311. 2870  DATA "If you don't have any points to change, just hit RETURN key." 
  312. 2880  DATA "Please command with the PFkeys." 
  313. 2890  DATA "If you have read this explanation, please hit any key." 
  314. 2900  DATA ""
  315. 2910  DATA "*Draw  -PF1"
  316. 2920  DATA " It makes a new figure and clears the datas."
  317. 2930  DATA "*Spin  -PF2"
  318. 2940  DATA " It spins the figure which was drawn around the frame of 'Y',"
  319. 2941  DATA "  (It don't clear the last figure.)"
  320. 2950  DATA "*Change-PF3"
  321. 2960  DATA " It changes your point of view,"
  322. 2970  DATA "  and spins as many angles as you like around what you like frame."
  323. 2980  DATA "*Save  -PF4"
  324. 2990  DATA " It keeps the figure which was drawn."
  325. 2991  DATA "  the kind of the data which was kept is ｢.tif｣file."
  326. 3000  DATA "*Reset -PF5"
  327. 3010  DATA " It resets this program."
  328. 3020  DATA "*End   -PF6"
  329. 3030  DATA " It ends this program."
  330. 3040  DATA Eom
  331. 3050  DATA 6                                            'keyの個数
  332. 3060  DATA "Draw","Spin","Change","Save","Reset","End"  'keyの内容
  333. 3070  DATA "The number of apex is " 
  334. 3071  DATA "The angl of X,Y,Z are "                  'サブメッセージの内容
  335. 3080 '
  336. 3090  DATA 10                                           '質問の数  
  337. 3100  DATA "What command do you give? >"                '(main)
  338. 3110  DATA "What color in the diagonal lines (0-7)? >"  '(spin)
  339. 3120  DATA "How many apex shall I draw (1-50)? >"  '(spin)
  340. 3130  DATA "How many angle shall I spin ? >"            '(spin)
  341. 3140  DATA "How many frames shall I draw ? >"           '(spin)
  342. 3150  DATA "Waht frame shall I spin around ? >"         '(change)
  343. 3160  DATA "How many angles shall I spin ? >"           '(change)
  344. 3170  DATA "What name shall I keep this program as ? >" '(save)
  345. 3171  DATA "May I reset this program (Yes or No)? >"    '(reset)
  346. 3180  DATA "May I end this program (Yes or No)? >"      '(end)
  347. 3190 '
  348. 3200 *JAPANESE
  349. 3210  DATA " これはあなたの好きなように正多角形を作る物です｡"
  350. 3220  DATA " また貴方の好きな色で対角線も作ります｡"
  351. 3230  DATA "  (０番は黒色です｡)
  352. 3240  DATA " 図形を書いている時にESCキーを押すと書くのを止めます｡"
  353. 3250  DATA " 前の場合と同じ時ははリターンキーを押してください｡"
  354. 3260  DATA " PFキーで指令してください｡"
  355. 3270  DATA " 読み終えたらリターンキーを押してください｡"
  356. 3280  DATA ""
  357. 3281  '
  358. 3290  DATA "*新規作成-PF１"
  359. 3300  DATA "   新しく正多角形を作ります。その際に今までのデータ"
  360. 3301  DATA "   ーは全て消去します。"
  361. 3310  DATA "*回転    -PF２"
  362. 3320  DATA "   今データーとしてある図形をＹ軸を中心にして回し"
  363. 3321  DATA "      ます。（前に書かれた物は消しません。）"
  364. 3330  DATA "*移動    -PF３"
  365. 3340  DATA "   いまデーターとしてある図形をＹ，Ｘ，Ｚ軸を中心に"
  366. 3341  DATA "   回します。"
  367. 3350  DATA "*保存    -PF４"
  368. 3360  DATA "   今画面に書かれている図形を｢．ｔｉｆ｣の形で保存し"
  369. 3361  DATA "  ます。"
  370. 3370  DATA "*ﾘｾｯﾄ    -PF５"
  371. 3380  DATA "   このプログラムをリセットして初期状態に戻します。"
  372. 3390  DATA "*終了    -PF６"
  373. 3400  DATA " 　このプログラムを終了します｡"
  374. 3410  DATA Eom
  375. 3420  DATA 6                                             'keyの個数
  376. 3430  DATA "新規作製","回転","移動","保存","ﾘｾｯﾄ","終了" 'keyの内容
  377. 3440  DATA " 頂点の数は = "
  378. 3441  DATA "X,Y,Z軸の角度は = "                     'サブメッセージの内容
  379. 3450  DATA 10                   
  380. 3460  DATA "何か指令してください >"                       '(メイン)
  381. 3470  DATA "   対角線は何色にしますか｡ (0-7)? >"          '(新規作成)
  382. 3480  DATA "　　正何角形を作りますか｡ (1-50)? >"          '(新規作成)
  383. 3490  DATA "     何度回転させますか｡? >"                  '(回転)
  384. 3500  DATA "     柱は何本にしますか｡? >"                  '(回転)
  385. 3510  DATA "  何軸を中心にして回しますか｡? >"             '(移動)
  386. 3520  DATA "     何度回転させますか｡? >"                  '(移動)
  387. 3530  DATA "   何と言う名前でこの図形を保存しますか｡?"    '(保存)
  388. 3540  DATA "  リセットしていいでしょうか｡(Yes or No)?"    '(ﾘｾｯﾄ)
  389. 3550  DATA "   終了していいでしょうか｡ (Yes or No)?  "    '(ﾘｾｯﾄ)
  390.